home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / newsgrp / group97b.txt / 000014_icon-group-sender _Fri Jul 4 08:02:35 1997.msg < prev    next >
Internet Message Format  |  2000-09-20  |  14KB

  1. Received: from kingfisher.CS.Arizona.EDU by cheltenham.cs.arizona.edu; Tue, 8 Jul 1997 08:45:36 MST
  2. Received: by kingfisher.CS.Arizona.EDU; (5.65v3.2/1.1.8.2/08Nov94-0446PM)
  3.     id AA24226; Tue, 8 Jul 1997 08:45:35 -0700
  4. Posted-Date: Fri, 4 Jul 1997 08:02:35 -0500 (CDT)
  5. Date: Fri, 4 Jul 1997 08:02:35 -0500 (CDT)
  6. From: Chris Tenaglia <cdt@post.its.mcw.edu>
  7. To: icon-group@cs.arizona.edu
  8. Subject: 4th of July Sample 2
  9. Message-Id: <Pine.SOL.3.96.970704075127.21094B-100000@post.its.mcw.edu>
  10. Mime-Version: 1.0
  11. Content-Type: TEXT/PLAIN; charset=US-ASCII
  12. Errors-To: icon-group-errors@cs.arizona.edu
  13. Status: RO
  14.  
  15. And for our second offering I post a binary file editor.
  16. I've used it on files up to 1MB. It views the file in
  17. terms of 256 byte sectors. It also assumes some kind of
  18. vt terminal emulation. This is getting close to system
  19. programming and the code gets thick doing binhex conversions
  20. and tracking screen locations. But I pity someone trying to
  21. do this in perl, c, or shell script. I suppose there is
  22. something you could buy to do this, but I didn't know of
  23. any so I wrote this. It took less time than the cost justification
  24. paperwork to buy a piece of software. 
  25.  
  26. *** danger : binary editing requires that you know what ***
  27. ***          are doing. Study carefully,test thoroughly ***
  28. ***          and there's no guarantee. Have fun!        ***
  29. ***          Yes, I have used it successfully on real stuff
  30.  
  31. So on with the code.
  32.  
  33. ########################  BEGIN PROGRAM #######################
  34. #
  35. # file : aped.icn
  36. # desc : binary editor like the old aped from srt days (unix version)
  37. # use  : aped file
  38. #
  39. # update          by           what
  40. # 02-sep-1995     tenaglia     initial write
  41. # 08-sep-1995     tenaglia     port this one to unix
  42. #
  43. global sctrs, pointer, hex, block, red, green, blue, black, con, coff, file
  44. procedure main(param)
  45.   write(con,blue,"\e[2JAPED V1.0 by Tenaglia")
  46.   file := param[1] | input("File:")
  47.   (in := open(file,"ur")) | stop(con,black,at(23,1),"No ",file)
  48.   sctrs := []
  49.   count := 0
  50.   green := "\e[1;33;42m"
  51.   blue  := "\e[1;33;44m"
  52.   red   := "\e[1;33;41m"
  53.   black := "\e[0m"
  54.   con   := "\e[?25h"
  55.   coff  := "\e[?25l"
  56.   hex   := "0123456789ABCDEF"
  57.  
  58. #
  59. # load the file into a sector list here
  60. #
  61.   while block := reads(in,256) do
  62.     {
  63.     if *block < 256 then
  64.       {
  65.       final := *block
  66.       block := left(block,256,"\000")
  67.       }
  68.     put(sctrs,block)
  69.     count +:= 1
  70.     }
  71.   close(in)
  72.   writes(con)
  73.  
  74.   pointer := 1                                      # begin at sector 1
  75.   repeat if patch(file)=="EXIT" then break          # continue patching
  76.  
  77. #
  78. # perhaps even write out the changes
  79. #
  80.   (out := open(file,"wu")) | stop(con,black,at(23,1),"Can't write ",file)
  81.   if *sctrs > 1 then every i := 1 to *sctrs-1 do writes(out,sctrs[i])
  82.   tail := sctrs[-1]
  83.   writes(out,tail[1+:final])
  84.   close(out)
  85.   write(con,black,at(23,1),file," rewritten.")
  86.   end
  87.  
  88. #
  89. # prompt for an input string
  90. #
  91. procedure input(prompt)
  92.   writes(con,prompt)
  93.   return read()
  94.   end
  95.  
  96. #
  97. # parse a string into a list with respect to a delimiter
  98. #
  99. procedure parse(line,delims)
  100.   static chars
  101.   chars  := &cset -- delims
  102.   tokens := []
  103.   line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
  104.   return tokens
  105.   end
  106.  
  107. #
  108. # patch oversees the display and edit of binary data
  109. #
  110. procedure patch(item)
  111.   display(item)
  112.   result := edit()
  113.   sctrs[pointer] := block
  114.   case result of
  115.     {
  116.     "QUIT" : stop(con,black,at(23,1),"Cancelled.")
  117.  "SAVE" | "EXIT" : return "EXIT"
  118.     "N" | "NEXT" : pointer +:= 1
  119.     "P" | "PRIOR": pointer -:= 1
  120.     "H" | "HOME" : pointer  := 1
  121.     "?" | "HELP" : help()
  122.     "$" | "END"  : pointer  := *sctrs
  123.     "G" | "GOTO" : pointer  := input(at(23,1) || blue || "GOTO SCTR # :")
  124.     }
  125.   if pointer < 1      then pointer := 1
  126.   if pointer > *sctrs then pointer := *sctrs
  127.   if match("DUMP",map(result,&lcase,&ucase)) then dump()
  128.   if match("GOTO",map(result,&lcase,&ucase)) & (*result > 6)then
  129.     {
  130.     new := trim(result[6:0])
  131.     if new == "" then new := input(at(23,1) || blue || "GOTO SCTR # :")
  132.     pointer := new
  133.     }
  134.   end
  135.  
  136. #
  137. # display the 256 byte block
  138. #
  139. procedure display(object)
  140.   write(blue,"\e[2J\e[HAPED V.1       Sector ",pointer," of ",*sctrs," of ",object,"\n")
  141.   block := sctrs[pointer]
  142.   every i := 1 to 256 do
  143.     {
  144.     b  := ord(block[i])
  145.     b1 := (b / 16) + 1
  146.     b2 := b - (b1 * 16)
  147.     writes(hex[b1],hex[b2]," ")
  148.     if i%16 = 0 then
  149.       {
  150.       base   := (pointer - 1) * 256
  151.       offset := i - 16
  152.       address:= radcon(base + offset,10,16)
  153.       write(" : ",address)
  154.       }
  155.     }
  156.   end
  157.  
  158. #
  159. # update the matrix of hex numbers currently displayed
  160. # There are 16 bytes per line, and 16 lines that are updatable
  161. #
  162. # row = index / 16 +3
  163. # col = index % 16 * 3
  164. #
  165. procedure edit()
  166.   index  := 1
  167.   hexset := cset(hex)
  168.   oldrow := 0
  169.   oldcol := 0
  170.   oldb1  := -1
  171.   oldb2  := -1
  172.   color  := blue
  173.   writes(coff)
  174.   repeat
  175.     {
  176.     b   := ord(block[index])
  177.     row := ((index - 1) / 16) + 3
  178.     col := ((index - 1) % 16) * 3 + 1
  179.     b1  := (b / 16) + 1
  180.     b2  := b - (b1 * 16)
  181.     writes(at(row,col),green,hex[b1],hex[b2])
  182.     (oldcol = 0) | writes(at(oldrow,oldcol),blue,hex[oldb1],hex[oldb2])
  183.     kee := lawkey()     # keyname(kee)
  184.     if *kee = 1 then kee := map(kee,&lcase,&ucase)
  185.     case kee of
  186.       {
  187.       "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" |
  188.       "8" | "9" | "A" | "B" | "C" | "D" | "E" | "F" :
  189.              {
  190.              writes(at(row,col),red,kee)
  191.              other := map(getch(),&lcase,&ucase)
  192.              any(hexset,other) | next
  193.              writes(at(row,col+1),red,other)
  194.              value := 16 * (find(kee,hex) - 1) + (find(other,hex) - 1)
  195.              color := if block[index] == char(value) then blue else red
  196.              block[index] := char(value)
  197.              index +:= 1
  198.              if index > 256 then index := 1
  199.              next
  200.              }
  201.       "G" : return "GOTO"
  202. " " | "N" : return "NEXT"
  203.       "P" : return "PRIOR"
  204.       "X" : return "SAVE"
  205.       "Z" : return "DUMP"
  206.       "?" : return "HELP"
  207.       "Q" : return "QUIT"
  208.       }
  209.     color := blue
  210.     case kee of
  211.       {
  212.       ":" |
  213.       "ESCAPE"   : return map(input(at(23,1) || blue || "Command:"),&lcase,&ucase)
  214.       "PAGEDOWN" : return "NEXT"
  215.       "PAGEUP"   : return "PRIOR"
  216.       "F10"      : { writes(at(23,1)) ; return "SAVE" }
  217.       "HOME"     : return "HOME"
  218.       "END"      : return "END"
  219.       "CTRL_C"   : return "QUIT"
  220.       "RETURN"   |
  221.       "ENTER"    :
  222.              {
  223.              oldb1 := b1 ; oldb2 := b2
  224.              oldrow:= row; oldcol:= col
  225.              new   := 16 * integer((index + 16) / 16)
  226.              index := new + 1
  227.          if index > 256 then index -:= 256
  228.              next
  229.              }
  230.       "RIGHTARROW" |
  231.       "SPACE" |
  232.       "TAB": {
  233.              oldb1  := b1  ; oldb2 := b2
  234.              oldrow := row ; oldcol:= col
  235.              index +:= 1
  236.              if index>256 then index := 1
  237.              next
  238.              }
  239.       "LEFTARROW" :
  240.              {
  241.              oldb1  := b1  ; oldb2 := b2
  242.              oldrow := row ; oldcol:= col
  243.              index -:= 1
  244.              if index<1 then index := 256
  245.              next
  246.              }
  247.       "UPARROW" :
  248.              {
  249.              oldb1  := b1  ; oldb2 := b2
  250.              oldrow := row ; oldcol:= col
  251.              index -:= 16
  252.              if index<1 then index +:= 256
  253.              next
  254.              }
  255.       "DOWNARROW" :
  256.              {
  257.              oldb1  := b1  ; oldb2 := b2
  258.              oldrow := row ; oldcol:= col
  259.              index +:= 16
  260.              if index>256 then index -:= 256
  261.              next
  262.              }
  263.       }
  264.     }
  265.   end
  266.  
  267. #
  268. #       \   button := getch()
  269. # usage  >  if button == "\000" then button ||:= getch()
  270. #       /   pressed  := keyname(button)
  271. #
  272. # map unusual keys to a string
  273. #
  274. procedure keyname(str)
  275.   static  keys
  276.   initial {
  277.           keys := table("ANY")
  278.           keys["\000;"] := "F1"
  279.           keys["\000<"] := "F2"
  280.           keys["\000="] := "F3"
  281.           keys["\000>"] := "F4"
  282.           keys["\000?"] := "F5"
  283.           keys["\000@"] := "F6"
  284.           keys["\000A"] := "F7"
  285.           keys["\000B"] := "F8"
  286.           keys["\000C"] := "F9"
  287.           keys["\000D"] := "F10"
  288.           keys["\000\373"] := "F12"
  289.  
  290.           keys["\000H"] := "UPARROW"
  291.           keys["\000P"] := "DOWNARROW"
  292.           keys["\000M"] := "RIGHTARROW"
  293.           keys["\000K"] := "LEFTARROW"
  294.           keys["\000I"] := "PAGEUP"
  295.           keys["\000Q"] := "PAGEDOWN"
  296.           keys["\000G"] := "HOME"
  297.           keys["\000O"] := "END"
  298.           keys["\000R"] := "INSERT"
  299.           keys["\000S"] := "DELETE"
  300.  
  301.           keys["\e"]    := "ESCAPE"
  302.           keys["\001"]  := "CTRL_A"
  303.           keys["\002"]  := "CTRL_B"
  304.           keys["\003"]  := "CTRL_C"
  305.           keys["\004"]  := "CTRL_D"
  306.           keys["\005"]  := "CTRL_E"
  307.           keys["\006"]  := "CTRL_F"
  308.           keys["\007"]  := "BELL"
  309.           keys["\010"]  := "BACKSPACE"
  310.           keys["\011"]  := "TAB"
  311.           keys["\012"]  := "LINEFEED"
  312.           keys["\013"]  := "CTRL_K"
  313.           keys["\014"]  := "FORMFEED"
  314.           keys["\015"]  := "RETURN"
  315.           keys["\016"]  := "CTRL_N"
  316.           keys["\017"]  := "CTRL_O"
  317.           keys["\020"]  := "CTRL_P"
  318.           keys["\021"]  := "CTRL_Q"
  319.           keys["\022"]  := "CTRL_R"
  320.           keys["\023"]  := "CTRL_S"
  321.           keys["\024"]  := "CTRL_T"
  322.           keys["\025"]  := "CTRL_U"
  323.           keys["\026"]  := "CTRL_V"
  324.           keys["\027"]  := "CTRL_W"
  325.           keys["\030"]  := "CTRL_X"
  326.           keys["\031"]  := "CTRL_Y"
  327.           keys["\032"]  := "CTRL_Z"
  328.           }
  329.   return keys[str]
  330.   end
  331.  
  332. #
  333. # THIS ROUTINE SETS THE CURSOR TO A GIVEN X (COL) Y(ROW) SCREEN LOCATION
  334. #
  335. procedure at(y,x)
  336.   return "\e[" || y || ";" || x || "f"
  337.   end
  338.  
  339. #
  340. # the next several modules are used to do base conversions
  341. # the most common being between 10 and 16
  342. #
  343. procedure exbase10(i,j)
  344.    static digits
  345.    local s, d, sign
  346.    initial digits := &digits || &lcase
  347.    if i = 0 then return 0
  348.    if i < 0 then {
  349.       sign := "-"
  350.       i := -i
  351.       }
  352.    else sign := ""
  353.    s := ""
  354.    while i > 0 do {
  355.       d := i % j
  356.       if d > 9 then d := digits[d + 1]
  357.       s := d || s
  358.       i /:= j
  359.       }
  360.    return sign || s
  361. end
  362.  
  363. procedure inbase10(s,i)
  364.    if s[1] == "-" then return "-" || integer(i || "r" || s[2:0])
  365.    else return integer(i || "r" || s)
  366. end
  367.  
  368. procedure radcon(s,i,j)
  369.    return exbase10(inbase10(s,i),j)
  370. end
  371.  
  372. #
  373. # detects keys from a LAWSON UNIVERSE client
  374. #
  375. procedure lawkey()
  376.   k := getch()
  377.   if k == "\x18" then return "F11"
  378.   if k == "\003" then return "CTRL_C"
  379.   if k == "\d"   then return "DEL"
  380.   if k == "\n"   then return "ENTER"
  381.   if k == "\t"   then return "TAB"
  382.   if k == "\r"   then return "RETURN"
  383.   if k == " "    then return "SPACE"
  384.   (k == "\e") | (return k)
  385.   k2 := getch()
  386.   (k2 == "[") | (k2 == "O") | return image(k || k2)
  387.   k3 := getch()
  388.   case k2 of
  389.     {
  390.     "[" : case k3 of {
  391.              "A" : return "UPARROW"
  392.              "B" : return "DOWNARROW"
  393.              "C" : return "RIGHTARROW"
  394.              "D" : return "LEFTARROW"
  395.              "V" : return "PAGEUP"
  396.              "U" : return "PAGEDOWN"
  397.              "4" : { getch() ; return "INS" }
  398.              default : return image(k || k2 || k3)
  399.              }
  400.     "O" : case k3 of {
  401.              "P" : return "F1"
  402.              "Q" : return "F2"
  403.              "R" : return "F3"
  404.              "S" : return "F4"
  405.              "T" : return "F5"
  406.              "U" : return "F6"
  407.              "V" : return "F7"
  408.              "W" : return "F8"
  409.              "X" : return "F9"
  410.              "Y" : return "F10"
  411.              "E" : return "STAB"
  412.              "]" : return "HOME"
  413.              "^" : return "END"
  414.              "o" : return "KP-"
  415.              default : return image(k || k2 || k3)
  416.              }
  417.     default : return image(k || k2 || k3)
  418.     }
  419.   return "?" || image(k || k2 || k3)
  420.   end
  421.  
  422. #
  423. # dump the current image, by writing out the current sectors
  424. # to a tmp file and then running hd in aped mode.
  425. #
  426. procedure dump()
  427.   temp     := "aped.tmp"
  428.   dumpfile := trim(file) || ".dmp"
  429.   final    := *block
  430.   cmd      := "which hd >" || temp
  431.   system(cmd)
  432.   write(con,at(23,1),black)
  433.   (in := open(temp)) | { error("No hd command") ; return }
  434.   result   := read(in)
  435.   close(in)
  436.   if find("not found",result) then { error("No hd command") ; return }
  437.   write(con,"Generating dump file...")
  438.   (out := open(temp,"wu")) | stop(con,black,at(23,1),"Can't write ",file)
  439.   if *sctrs > 1 then every i := 1 to *sctrs-1 do writes(out,sctrs[i])
  440.   tail := sctrs[-1]
  441.   writes(out,tail[1+:final])
  442.   close(out)
  443.   cmd := "hd " || temp || " -aped >" || dumpfile
  444.   system(cmd)
  445.   write(con,dumpfile," written. Press ENTER to continue.")
  446.   getch()
  447.   end
  448.  
  449. #
  450. # display an error message
  451. #
  452. procedure error(msg)
  453.   write(con,"\7",msg)
  454.   writes(con,"Press ENTER to continue.")
  455.   getch()
  456.   end
  457.  
  458. #
  459. # brief online help screen
  460. #
  461. procedure help()
  462.   write(con,at(10,10),red,"     Very Brief Help      ")
  463.   write(con,at(11,10),red," :  - Command Mode        ")
  464.   write(con,at(12,10),red," G  - Goto Sctr   : GOTO  ")
  465.   write(con,at(13,10),red," N  - Next Sctr   : NEXT  ")
  466.   write(con,at(14,10),red," P  - Prior Sctr  : PRIOR ")
  467.   write(con,at(15,10),red," H  - Home Sctr 1 : HOME  ")
  468.   write(con,at(16,10),red," $  - Last Sctr   : EOF   ")
  469.   write(con,at(17,10),red," Q  - Quit/nosave : QUIT  ")
  470.   write(con,at(18,10),red," X  - Exit/Save   : EXIT  ")
  471.   write(con,at(19,10),red," Z  - Dump Hex    : DUMP  ")
  472.   write(con,at(20,10),red," Press ENTER to continue. ")
  473.   getch()
  474.   end
  475. ####################  END PROGRAM   #########################
  476.  
  477. Chris Tenaglia   (system manager)     |  The future foretold,
  478. Medical College of Wisconsin          |  The past explained,
  479. 8701 W. Watertown Plank Rd.           |  The present largely appologized for.
  480. Milwaukee, WI 53226   (414)456-8765   |  Organon to the Doctor
  481.  
  482.  
  483.